home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / Source / DBL Pascal Library / Misc / ShortFract next >
Text File  |  1991-04-30  |  1KB  |  61 lines
  1. unit ShortFract;
  2.  
  3. {Provide a short fraction type (for cases where the precision of the Fract type is not needed),}
  4. {and conversions between ShortFract and Fract types. A ShortFract can have values ranging}
  5. {from -2 to 2-(2^14), inclusive. ShortFracs obey twos complement arithmetic, and can be}
  6. {added, subtracted, negated, and compared. Use the Fract routines on converted ShortFract}
  7. {values for multiplication, division, and trig functions. See IM IV-63 for details on the Fract type.}
  8.  
  9. interface
  10.  
  11.     const
  12.         SF_Pos1 = $4000;
  13.         SF_Neg1 = $C000;
  14.         SF_PosHalf = $2000;
  15.         SF_NegHalf = $E000;
  16.  
  17.     type
  18.         ShortFract = Integer;
  19.  
  20.     function Fract2ShortFract (f: Fract): ShortFract;
  21.     function ShortFract2Fract (s: ShortFract): Fract;
  22.  
  23. implementation
  24.  
  25.     type
  26.         FractParts = record
  27.                 hi, lo: Integer;
  28.             end;
  29.         FractConvert = record
  30.                 case Integer of
  31.                     1: (
  32.                             f: Fract;
  33.                     );
  34.                     2: (
  35.                             s: ShortFract;
  36.                     );
  37.                     3: (
  38.                             p: FractParts;
  39.                     );
  40.             end;
  41.  
  42.     function Fract2ShortFract (f: Fract): ShortFract;
  43.         var
  44.             result: ShortFract;
  45.     begin
  46.         result := FractConvert(f).s;
  47.         if FractConvert(f).p.lo < 0 then    {round if needed}
  48.             result := result + 1;
  49.         Fract2ShortFract := result;
  50.     end;
  51.  
  52.     function ShortFract2Fract (s: ShortFract): Fract;
  53.         var
  54.             result: Fract;
  55.     begin
  56.         FractConvert(result).s := s;
  57.         FractConvert(result).p.lo := 0;
  58.         ShortFract2Fract := result;
  59.     end;
  60.  
  61. end.